;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ViVa - ViSta's Variable Language
;;;
;;; This file contains the macro-character definition
;;; of curly braces and square brackets
;;; Version 1.0 by Forrest W. Young, 102399 - 111199
;;; Version 1.1 by Forrest W. Young, April, 2000
;;; Added *viva-readtable* constant, December, 2000
;;;
;;; VIVA is an interface to PARCIL which evaluates c-like
;;; expressions typed into the XLisp listener.
;;;
;;; If the expression involves assignment to a variable, 
;;; the variable is bound to the expression's value using 
;;; ViSta's VAR function. VAR creates a variable object and adds
;;; the variable to the $free-vars and $all-vars lists. In a
;;; later release the variable will be iconized on the desktop.
;;;
;;; LIMITATIONS:
;;; 1) All dashes are interpreted as minus signs. Thus, character 
;;;    strings, including variable and function names, cannot 
;;;    contain dashes, as is very common in Lisp. However, 
;;;    ViVa will automatically process underscores as dashes, but
;;;    not as minus signs. This means that you can type
;;;       normal_vec = normal_rand(50)
;;;       centered_normal_vec = (normal_vec - mean(normal_vec))
;;;    and ViVa will correctly process the underscores (_) and 
;;;    minus signs (-).
;;; 2) ViVa statements cannot be read from files or 
;;;    evaluated in the editor. They can only be entered
;;;    in the listener.
;;;
;;; USAGE: 
;;; VIVA can be used in 3 ways (*viva-verbose* controls printing)
;;;
;;; 1) At the Listener, type a c-like expression enclosed in square
;;;    brackets or curly braces. It is evaluated and the value is returned. 
;;;
;;;    > [a=3*iseq(4)]
;;;    (0 3 6 9)
;;;    > a
;;;    (0 3 6 9)
;;;    > 
;;;
;;; 2) At the Listener, type a left bracket or brace and a return. 
;;;    The ViVa ? prompt appears. You can type a c-like expressions
;;     followed by a return. The expression is evaluated. The ViVa
;;;    ? prompt appears. Type a right bracket or brace to return 
;;;    to lisp. ViVa returns the value of the last expression.
;;;
;;;   > [
;;;   ?2+3
;;;   5
;;;   ?a=4*6^2
;;;   144
;;;   ?a
;;;   144
;;;   ?b=sqrt(a)
;;;   12.0
;;;   ?]
;;;   12.0
;;;   > 
;;;
;;; 3) Within any code, enter a bracket or brace enclosed statement 
;;;    in the middle of lisp. It is evaluated. The value is returned:
;;;     >(list 1 3 [sqrt(25)] 7)
;;;     (1 3 5.0 7)
;;;     >
;;;
;;; Here is the code that implements VIVA:
;;;


(defun syntax-error ()
  (format t "; syntax error in: ~a~%;        found at: ~a~%" 
          *the-string* 
          (strcat (apply #'strcat (repeat "-" (1- *the-pointer*))) "^"
                  (apply #'strcat (repeat "-" (- (length *the-string*) *the-pointer*))))))

(defun eval-parcil (string)
  (let* ((lisp  (underscores-to-dashes (parcil string)))
        (result (multiple-value-list (ignore-errors (eval lisp)))))
    (cond 
      ((> (length result) 1)
       (format nil "; evaluation error: ~a"(second result)))
      (t
       (eval lisp)))))

(defun underscores-to-dashes (list)
  (let ((element))
    (cond
      ((listp list)
       (dotimes (i (length list))
                (setf element (select list i))
                (if (listp element) 
                    (underscores-to-dashes element)
                    (setf (select list i) 
                          (underscore-to-dash element))))
       )
       (t (setf list (underscore-to-dash list)))
      )
    list))

(defun underscore-to-dash (symbol-or-string)
  (let* ((string (cond 
                   ((symbolp symbol-or-string) 
                    (format nil "~a" symbol-or-string))
                   ((stringp symbol-or-string)
                    symbol-or-string)
                   (t nil)))
         (position (if string (search "_" string) nil))
         (new-string string))
    (cond 
      ((not string) symbol-or-string)
      (position (setf new-string (substitute-string "-" string position))
                (when (equal "-" (subseq new-string (1- (length new-string))))
                      (setf new-string 
                            (subseq new-string 0 (1- (length new-string)))))
                (underscore-to-dash new-string))
      (t (intern (string-upcase string))))))

;adds error handling feature

(defun viva ()
"VIVA is an interface to PARCIL which evaluates c-like expressions typed into the XLisp listener. If the expression involves assignment to a variable, the variable is bound to the expression's value using ViSta's VAR function. VAR creates a variable object and adds the variable to the $free-vars and $all-vars lists.

LIMITATIONS:
1) PARCIL interprets all dashes as minus signs. Thus, character strings, including variable and function names, cannot contain dashes, as is very common in Lisp. However, ViVa assumes that dashes surrounded by alphabetics are really dashes and converts them to underscores so that PARCIL sees underscores rather than dashes.
2) ViVa statements cannot be read from files or evaluated in the editor. They can only be entered in the listener."
  (ignore-errors
  (let ((string)(eval-parcil)(result)(first t)(c #\Newline))
    (loop 
        (setf c (read-char))
         (cond 
           ((or (eql c #\}) (eql c #\]) (eql c #\Newline))
            (cond 
              (string 
               (setf eval-parcil (eval-parcil string))
               (setf string nil)
               (cond 
                 ((eql c #\Newline)
                  (if viva-verbose 
                      (format t "~a~%? " eval-parcil)
                      (format t "? "))
                  (setf result (list eval-parcil)))
                 ((or (eql c #\}) (eql c #\]) )
                  (setf result (list eval-parcil))
                  (return (list (quote result))))
                 (t (error "; viva - impossible branch 1"))))
              (t
               (cond
                 ((eql c #\Newline) (format t "? "))
                 ((or (eql c #\}) (eql c #\]) ) (return result))
                 (t (error "; viva - impossible branch 2"))))))
           (t (setf string (strcat string (string c)))
              )))
    (setf result `(',(first result)))
    result)
   )
  )


(set-macro-character
  #\{
  #'(lambda (stream char)
      (declare (ignore char))
      (viva)))

(set-macro-character
  #\[
  #'(lambda (stream char)
      (declare (ignore char))
      (viva)))

;following added by fwy12312000
(defconstant *viva-readtable* *readtable*)

(setf *viva* nil)

(defun viva-verbose ()
"Args: none
Toggles the *viva-verbose* global variable."
  (setf viva-verbose (not viva-verbose))
  (setf *viva-verbose* viva-verbose)
  *viva-verbose*)

(defun viva-window ()
  (cond
    (*viva*
     (send *listener* :front-window)
     )
    (t
     (maximize-workmap)
     (send *listener* :size 600 170)
     (dotimes (i 20) (terpri))
     (send *listener* :title "ViVa - ViSta's Interactive Variable Algebra System")
     (write-viva-listener-header)
     (write-viva-listener-help)
     (send *listener* :size 600 250)
     (send *listener* :location 50 100)
     (send *listener* :pop-out t)
     (send *listener* :no-move nil)
     (defmeth *listener* :close ()
       (restore-desktop)
       (defmeth *listener* :close () (call-next-method))
       (setf *viva* nil)
       (top-level nil))
    ; (defmeth *listener* :size (&rest args) )
    ; (defmeth *listener* :location (&rest args) )
     ))
  *viva*)

(defun edit-variables () (viva-window))

(defun using-viva () (the-variable-language))

(defun write-viva-listener-header ()
  (format t "~%ViVa:   ViSta's Interactive Variable Algebra System~%        Copyright (c) 1999-~a by Forrest W. Young. All rights reserved.~%" (select (get-decoded-time-list) 5))
  (format t "Parcil: Parse C into Lisp - Copyright (c) 1992 by Erann Gat. All rights reserved.~%        Used under terms of GNU General Public License, Free Software Foundation.~%"))

(defun write-viva-listener-help ()
  (format t "~%At ViSta's > prompt, type (using-viva) for help using ViVa.~%At ViVa's  ? prompt, type using_viva() for help using ViVa.~%")
  (format t "~%Current Data Object: ~a" (if $ $ "[none]"))
  (format t "~%Current Variables:   ~a~%" (if $vars  $vars "[none]"))
  (format t "~%Type (viva) to run ViSta's Variable editor.~%> "))